home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 7 / BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso / Files / Bus / A / almanac 1.5 .cpt / Almanac v 1.5 / stack.txt < prev   
Text File  |  1989-01-02  |  10KB  |  333 lines
  1. -- stack: in.5
  2. -- format: 8 (HyperCard 1)
  3. -- flags: 0x1000 (none)
  4. -- protect password hash: 0
  5. -- maximum user level: 5 (scripting)
  6. -- window: Rect(x1=0, y1=0, x2=0, y2=0)
  7. -- screen: Rect(x1=0, y1=0, x2=0, y2=0)
  8. -- card dimensions: w=0 h=0
  9. -- scroll: x=0 y=0
  10. -- background count: 3
  11. -- first background id: 2765
  12. -- card count: 12
  13. -- first card id: 2966
  14. -- list block id: 7899
  15. -- print block id: 0
  16. -- font table block id: 0
  17. -- style table block id: 0
  18. -- free block count: 0
  19. -- free size: 0 bytes
  20. -- total size: 40768 bytes
  21. -- stack block size: 8704 bytes
  22. -- created by hypercard version: 0x00000000
  23. -- compacted by hypercard version: 0x01208000
  24. -- modified by hypercard version: 0x01208000
  25. -- opened by hypercard version: 0x01208000
  26. -- patterns[0]: 0x0000000000000000
  27. -- patterns[1]: 0x8000000008000000
  28. -- patterns[2]: 0x8800220088002200
  29. -- patterns[3]: 0x8888222288882222
  30. -- patterns[4]: 0x88AA22AA88AA22AA
  31. -- patterns[5]: 0xCCAA33AACCAA33AA
  32. -- patterns[6]: 0xEEAABBAAEEAABBAA
  33. -- patterns[7]: 0xEEBBBBEEEEBBBBEE
  34. -- patterns[8]: 0xFFBBFFEEFFBBFFEE
  35. -- patterns[9]: 0xFFBBFFFFFFBBFFFF
  36. -- patterns[10]: 0x8010022001084004
  37. -- patterns[11]: 0xFFFFFFFFFFFFFFFF
  38. -- patterns[12]: 0x8822882288228822
  39. -- patterns[13]: 0x1122448811224488
  40. -- patterns[14]: 0xC4800C6843023026
  41. -- patterns[15]: 0xB130031BD8C00C8D
  42. -- patterns[16]: 0xAA00AA00AA00AA00
  43. -- patterns[17]: 0x8822552288225522
  44. -- patterns[18]: 0x8855225588552255
  45. -- patterns[19]: 0x77DD77DD77DD77DD
  46. -- patterns[20]: 0x8000000000000000
  47. -- patterns[21]: 0xAA55AA55AA55AA55
  48. -- patterns[22]: 0x038448300C020101
  49. -- patterns[23]: 0x8244394482010101
  50. -- patterns[24]: 0x8814224188412214
  51. -- patterns[25]: 0x8080413E080814E3
  52. -- patterns[26]: 0x22048C7422179810
  53. -- patterns[27]: 0xBE808808EB088880
  54. -- patterns[28]: 0x25C8328964244C92
  55. -- patterns[29]: 0xA29C41BE2AC914EB
  56. -- patterns[30]: 0x40A00000040A0000
  57. -- patterns[31]: 0x8040200002040800
  58. -- patterns[32]: 0xAA00800088008000
  59. -- patterns[33]: 0xFF80808080808080
  60. -- patterns[34]: 0x081C22C180010204
  61. -- patterns[35]: 0xFF808080FF080808
  62. -- patterns[36]: 0xF87422478F172271
  63. -- patterns[37]: 0xBF00BFBFB0B0B0B0
  64. -- patterns[38]: 0xFF7FBE5DA2418000
  65. -- patterns[39]: 0xFAF5FAF5A050A050
  66. -- checksum: 0x0
  67. ----- HyperTalk script -----
  68. on openStack
  69.   global val,force
  70.   put 0 into force
  71.   hide message box
  72.   hide field rem
  73.   put the seconds/86400 + 16480.5 + 5/24 into jd2
  74.   put trunc(jd2+24000000) +1 into jd
  75.   get the date
  76.   convert it to dateItems
  77.   put item 2 of it into m
  78.   put item 3 of it into d
  79.   put false into val
  80.   if m>4 and m<=10 then put true into val
  81.   put trunc(jd-7*trunc(jd/7)) into w
  82.   if m=4 and d>w then put true into val
  83.   if m=10 and (d-w)>=25 then put false into val
  84.   push card
  85.   if the number of this cd is 1 then
  86.     put line 2 of card field "Algol" into ecl
  87.     repeat
  88.       if ecl > jd2 then exit repeat
  89.       add 2.8673075 to ecl
  90.     end repeat
  91.     set numberFormat to "0.0"
  92.     put "Next minimum of Algol occurs in" && (ecl-jd2)*24 && "hours at JD=" into line 1 of card field Algol
  93.     set numberFormat to "0.###"
  94.     put ecl+2400000 after line 1 of card field Algol
  95.     put ecl into line 2 of card field Algol
  96.   end if
  97.   set numberFormat to "0.######"
  98. end openStack
  99.  
  100. function TJDDate
  101. get the seconds
  102. add 86400+3600*(12+DSTcheck()) to it
  103. convert it to long date
  104. put char 1 to (offset(",",third word of it)-1) of third word of it && second word of it && last word of it into he
  105. return he
  106. end TJDDate
  107.  
  108. function getDate
  109. get the long date
  110. put char 1 to (offset(",",third word of it)-1) of third word of it && second word of it && last word of it into he
  111. return he
  112. end getDate
  113.  
  114. function getJDDate
  115. get the seconds
  116. add 3600*(12+DSTcheck()) to it
  117. convert it to long date
  118. put char 1 to (offset(",",third word of it)-1) of third word of it && second word of it && last word of it into he
  119. return he
  120. end getJDDate
  121.  
  122. function getUTDate
  123. get the seconds
  124. add 3600*(DSTcheck()) to it
  125. convert it to long date
  126. put char 1 to (offset(",",third word of it)-1) of third word of it && second word of it && last word of it into he
  127. return he
  128. end getUTDate
  129.  
  130. function DSTcheck
  131. get first word of line 4 of card field Coords of first cd
  132. if hilite of bkgnd button "DST"
  133. then put it-1 into temp
  134. else put it into temp
  135. return temp
  136. end DSTcheck
  137.  
  138. on dayOfYear
  139.   -- returns day, dayUT as number of day in year
  140.   global dayUT,day,daySecs
  141.   put the date into daySecs
  142.   convert daySecs to seconds
  143.   put number of chars of the date into ndate
  144.   put "12/31/" & (char ndate-1 to ndate of the date)-1 into Jan0
  145.   convert Jan0 to seconds
  146.   put (daySecs-Jan0)/86400 into day
  147.   put (daySecs-Jan0+3600*DSTcheck())/86400 into dayUT
  148. end dayOfYear
  149.  
  150. on cheb a,b,c
  151.   global x,xa,xb
  152.   put 2*x*a-b+c into temp
  153.   put a into xb
  154.   put temp into xa
  155. end cheb
  156.  
  157. on UT
  158.   global day,daySecs,x,xa,xb,m
  159.   dayOfYear -- gets daySecs
  160.   get ((the seconds-daySecs)/3600+DSTcheck())mod 24
  161.   put trunc(it) into h
  162.   put trunc(60*(it-h)) into m
  163.   if m<10 then put "0" before m
  164.   put "Universal Time = "& h &":" & m into line 1 of field 1
  165.   put it into line 2 of field 1
  166. end UT
  167.  
  168. on ST
  169.   global day,daySecs,x,xa,xb,dayUT
  170.   dayOfYear -- gets day
  171.   put (dayUT-1)/183-1 into x
  172.   put 0 into a
  173.   put 0 into b
  174.   put 7 into i
  175.   repeat until i=0
  176.     cheb a,b,word i+1 of card field "Sidereal Cheb" of card 1
  177.     put xa into a
  178.     put xb into b
  179.     subtract 1 from i
  180.   end repeat
  181.   put xb into b2
  182.   cheb a,b,word 1 of card field "Sidereal Cheb" of card 1
  183.   get ((xa-b2)/2+((the seconds-daySecs)/3600+DSTcheck())*1.00273791- (line 2 of card field "coords" of card 1)/15+24) mod 24
  184.   put trunc(it) into h
  185.   put trunc(60*(it-h)) into m
  186.   if m<10 then put "0" before m
  187.   put "Sidereal Time = "& h &":" & m into line 1 of field 2
  188.   put it into line 2 of field 2
  189. end ST
  190.  
  191. on hm decv
  192.   global it,h,m
  193.   put trunc(it) into h
  194.   put trunc(60*(it-h)) into m
  195.   if decv then put abs(m) into m
  196.   if m<10 then put "0" before m
  197. end hm
  198.  
  199. on calc num,force
  200.   set cursor to 1001
  201.   -- calcs ra and dec
  202.   put pi/180 into fac
  203.   global day,daySecs,x,xa,xb,dayUT,it,h,m,mode
  204.   dayOfYear -- gets day,dayUT
  205.   get line 3 of field 1
  206.   put fac*(line 1 of card field "Coords" of card 1) into lat
  207.   if (it=trunc(dayUT) and the optionkey is up) and force=0 then
  208.     put line 5 of field 5 into dra
  209.     put (line 6 of field 5)*fac into dec
  210.     put line 3 of field 6 into arg
  211.   else
  212.     set cursor to 1002
  213.     put trunc(dayUT) into line 3 of field 1
  214.     put (dayUT+((the seconds-daySecs)/3600+DSTcheck())/24-1)/183-1 into x
  215.     put 0 into a
  216.     put 0 into b
  217.     put num into i
  218.     repeat until i=0
  219.       cheb a,b,word i+1 of field 3
  220.       set cursor to busy
  221.       put xa into a
  222.       put xb into b
  223.       subtract 1 from i
  224.     end repeat
  225.     put xb into b2
  226.     cheb a,b,word 1 of field 3
  227.     get ((xa-b2)/2+48) mod 24
  228.     put it*15 into dra
  229.     put dra into line 5 of field 5
  230.     hm false
  231.     put short name of this card &" R.A. = "& h &"h " & m &"m"into line 1 of field 5
  232.     put 0 into a
  233.     put 0 into b
  234.     put num into i
  235.     repeat until i=0
  236.       cheb a,b,word i+1 of field 4
  237.       set cursor to busy
  238.       put xa into a
  239.       put xb into b
  240.       subtract 1 from i
  241.     end repeat
  242.     put xb into b2
  243.     cheb a,b,word 1 of field 4
  244.     get (xa-b2)/2
  245.     put it*fac into dec
  246.     put it into line 6 of field 5
  247.     put empty into sign
  248.     if it<0 and it>-1 then put "-" into sign
  249.     if it>0 then put "+" into sign
  250.     hm true
  251.     put short name of this card&" Dec.  = "&sign&h&"¬∞ "&m&"'" into line 2 of field 5
  252.     if short name of this card is in "Sun" then
  253.       get (-.2079-sin(lat)*sin(dec))/cos(lat)/cos(dec)
  254.       put atan(sqrt(1-it*it)/it) into ang
  255.       add pi to ang
  256.       if sin(lat)*sin(dec)<0.2079 then
  257.         add pi to ang
  258.       end if
  259.       put ang/fac/15 into delta
  260.       put dra/15+(line 2 of field 1)-line 2 of field 2+24-DSTcheck() into arg
  261.       get (arg-delta) mod 24
  262.       put it into line 3 of card field 1
  263.       hm false
  264.       ampm
  265.       put "Twilight begins at "& h &":" & m && mode into line 1 of cd fld 1
  266.       get (arg+delta) mod 24
  267.       put it into line 4 of cd fld 1
  268.       hm false
  269.       ampm
  270.       put "Twilight ends    at "& h &":" & m && mode into line 2 of cd fld 1
  271.     end if
  272.     get -sin(lat)*sin(dec)/cos(lat)/cos(dec)
  273.     put atan(sqrt(1-it*it)/it) into ang
  274.     if dec>0 then
  275.       add pi to ang
  276.     end if
  277.     put ang/fac/15 into delta
  278.     put dra/15+line 2 of field 1-line 2 of field 2+24-DSTcheck()into arg
  279.     get (arg-delta) mod 24
  280.     put arg into line 3 of field 6
  281.     put it into line 4 of field 6
  282.     hm false
  283.     ampm
  284.     put short name of this card && "Rises at "& h &":" & m && mode into line 1 of field 6
  285.     get (arg+delta) mod 24
  286.     put it into line 5 of field 6
  287.     hm false
  288.     ampm
  289.     put short name of this card && "Sets  at "& h &":" & m && mode into line 2 of field 6
  290.   end if
  291.   -- calc alt and az of object
  292.   put ((360+15*(line 2 of field 2)-dra) mod 360)*fac into LHA
  293.   put cos(LHA)*sin(lat)-tan(dec)*cos(lat) into den
  294.   get atan(sin(LHA)/den)
  295.   if den>0 then
  296.     get pi+it
  297.   else
  298.     if sin(LHA)>0
  299.     then get 2*pi+it
  300.   else get it
  301. end if
  302. put round(it/fac) into temp
  303. put sin(lat)*sin(dec)+cos(lat)*cos(dec)*cos(LHA) into sina
  304. if abs(sina)<1 then
  305.   get round(atan(sina/(sqrt(1-sina*sina)))/fac)
  306.   if it>0 then
  307.     put "Az. = "& temp into line 3 of field 5
  308.     put "Alt. = " & it into line 4 of field 5
  309.   else
  310.     if temp>180
  311.     then put "W" into tem
  312.   else put "E" into tem
  313.   put "below " & tem & " horizon" into line 3 of field 5
  314.   put empty into line 4 of field 5
  315. end if
  316. else
  317.   beep
  318. end if
  319. set cursor to 1
  320. end calc
  321.  
  322. on ampm
  323.   global h,mode
  324.   if h>11 then
  325.     subtract 12 from h
  326.     put "PM" into mode
  327.   else
  328.     put "AM" into mode
  329.   end if
  330.   if h=0 then put 12 into h
  331. end ampm
  332.  
  333.